SPACE 1/SPACE - Library 1 - Volume 1.iso/program/114/xref2.bas

BASIC Source File | 1987-10-17 | 18KB | 566 lines

Rem GFA Basic cross-referencer
Rem ********** LEGAL NOTICE **********
Rem Copyright (C) 1987 by Don Edwards
Rem Permission is granted to distribute this program without charge
Rem or for reasonable media charge only.
Rem Permission is granted to put this program on any computer bulletin
Rem board for downloading without charge or for normal access charges only.
Rem
Rem All other rights reserved
Rem
Rem "GFA-BASIC" may be a registered trademark owned by
Rem Michtron, Inc (US) and/or GFA-Systemtechnik (Germany). It
Rem is the name of a computer program written by GFA-Systemtechnik
Rem and distributed in the US by Michtron, which program is covered
Rem by US and foreign copyrights.
Rem ********** END NOTICE **********
Rem
Rem What this program does:
Rem
Rem This program reads a GFA Basic program (Ascii save) and produces
Rem two output files. The first is the listing with line numbers added;
Rem the second is a list of variables and procedures, in alphabetic
Rem order, with the line numbers of all references.
Rem (It also uses 4 temporary files - RAMdisk STRONGLY recommended)
Rem
Rem main procedure
Qqqinputread%=0
Cls ! clear screen
@Get_filenames
@Examine_source
@Sort_references
@Combine_references
@Format_report
End
Procedure Get_a_char
  Rem This procedure provides a large buffer for character by
  Rem character input. It also cooperates with the next procedure
  Rem to allow quick input of the rest of the current line
  Rem
  If Qqqinputread%=0
    Qqqinputread%=1
    Qqqinputlen%=Lof(#1)
    Qqqicurlen%=-1
    Qqqinputpos%=0
  Endif
  If Qqqinputpos%>=Qqqicurlen%
    Qqqicurlen%=Min(Max(1,Qqqinputlen%-1),10240)
    Sub Qqqinputlen%,Qqqicurlen%
    Qqqinputpos%=0
    Qqqinputbuf$=Input$(Qqqicurlen%,#1)
  Endif
  Inc Qqqinputpos%
  C$=Mid$(Qqqinputbuf$,Qqqinputpos%,1)
  Cu$=Upper$(C$)
  C%=Asc(C$)
  Out #3,C%
Return
Procedure Finish_the_line
  Rem this procedure causes the rest of the current line to be
  Rem skipped over and passed to the numbered file, without examining
  Rem each character separately.
  Rem
  Local X%
  X%=Instr(Qqqinputpos%+1,Qqqinputbuf$,Chr$(13))
  If X%>0
    Dec X%
    Print #3;Mid$(Qqqinputbuf$,Qqqinputpos%+1,X%-Qqqinputpos%);
    Qqqinputpos%=X%
    @Get_a_char
  Else
    Print #3;Mid$(Qqqinputbuf$,Qqqinputpos%+1);
    Qqqinputpos%=Qqqicurlen%
    @Get_a_char
    If C%<>13
      @Finish_the_line
    Endif
  Endif
Return
Procedure Examine_source
  Rem
  Rem this code reads the .LST file and produces a list of (line#, var)
  Rem in a temporary file. (Note: "var" is anything that looks like a word
  Rem but is not a Basic keyword; it includes procedure names, function
  Rem names, and labels as well as variables)
  Rem
  Open "I",#1,Lst$
  Open "O",#2,Tempfile1$
  Open "O",#3,Lnm$
  Lnum%=1
  Print #3,Using "#### ",Lnum%;
  Print "Reading Line ";
  Lnox%=Crscol
  Lnoy%=Crslin
  Print Lnum%;
  @Get_a_char
  Rem
  Rem in the following loop, C% contains the ascii code of the next char
  Rem C$ contains the character
  Rem Cu$ contains the uppercase version of the character
  Rem these must ALWAYS be true at the beginning of a pass thru the loop
  Rem
  Repeat
    If Cu$>="A" And Cu$<="Z" ! start of a word
      Word$=C$ ! begin saving the word
      If Not Eof(#1)
        @Get_a_char ! get the next character
        Do
          Let Exit!=False
          If (C$>="0" And C$<="9") Or (Cu$>="A" And Cu$<="Z") Or C$="_" Or C$="."
            Word$=Word$+C$ ! add a letter, digit, underscore, dot
          Else
            If C$="$" Or C$="%" Or C$="!" Or C$=":" Or C$="?"
              Word$=Word$+C$ ! add type char & terminate
              @Get_a_char ! get the next character
              Let Exit!=True
            Else ! character not part of a word
              Let Exit!=True
            Endif
          Endif
          Exit If Eof(#1) Or Exit!
          @Get_a_char ! if staying, get the next character
        Loop
      Endif
      @Deal_with_word
    Else ! not a word
      If C%=13 ! carriage return
        Inc Lnum% ! increment line counter
        If Not Eof(#1)
          @Get_a_char ! discard linefeed
          If Not Eof(#1) ! there is a next line
            Print #3,Using "#### ",Lnum%; ! numbered file
            Print At(Lnox%,Lnoy%);Lnum%
            @Get_a_char ! get 1st char of new line
          Endif
        Endif
      Else ! not word, carriage return
        If (C$>="0" And C$<="9") Or C$="&" ! numbers
          Do ! skip the number
            Exit If Eof(#1)
            @Get_a_char
            Exit If Not ((C$>="0" And C$<="9") Or (C$>="A" And C$<"G") Or C$="H" Or C$="X" Or C$="O" Or C$=".")
          Loop
        Else ! not word, carriage return, number
          If C%=34 ! double quotes
            Repeat ! skip the quoted string
              Exit If Eof(#1) ! if file ends, stop
              @Get_a_char
            Until C%=34 Or C%=13 ! until matching quote or end of line
            If C%=34 ! skip closing quote
              @Get_a_char
            Endif
          Else ! not word, carriage return, number, quoted string
            If C$="!" ! on-the-line comment
              @Finish_the_line
            Else ! don't know what it is - ignore it
              @Get_a_char
            Endif
          Endif
        Endif
      Endif
    Endif
  Until Eof(#1)
  Close #1
  Close #2
  Close #3
Return
Procedure Deal_with_word
  Rem
  Rem this routine takes the word in Word$ and tries to find what it is.
  Rem if it's REM or DATA, the rest of the line is skipped
  Rem otherwise, we look through a list of basic keywords - if we find
  Rem the word, we're done.
  Rem failing that, we write a line to file 2 consisting of the line#
  Rem (in lnum) and the word
  Rem
  Local Lo%,Hi%,Mid%
  Uword$=Upper$(Word$) ! uppercase for faster comparisons
  If Not Word_list_read! ! first time thru - build the word list
    @Read_word_list
  Endif
  If Uword$="REM" Or Uword$="DATA"
    @Finish_the_line
  Else ! do a binary search on the word list
    Lo%=0 ! slot 0 unused
    Hi%=Word_list_limit% ! this slot "//", not a valid word
    Rem word, if present, is between lo% and hi%, exclusive at both ends
    Do
      Mid%=(Lo%+Hi%)/2 ! find midpoint
      Exit If Mid%=Lo% ! implies nothing between lo% and hi%
      Found!=(Hold_word_list$(Mid%)=Uword$) ! is midpoint the word?
      Exit If Found!
      If Hold_word_list$(Mid%)<Uword$ ! nope... if too low in list
        Lo%=Mid% ! move lo% up
      Else ! must be too high in list
        Hi%=Mid% ! move hi% down
      Endif
    Loop
    If Not Found!
      Print #2,Lnum%;",";Word$
    Endif
  Endif
Return
Procedure Read_word_list
  Rem
  Rem build the word list in an array, doing sequence checking
  Rem so that binary search may go unimpeded.
  Rem
  Word_list_read!=True ! we've been here now
  Dim Hold_word_list$(300) ! the list
  Word_list_limit%=0 ! unused slot
  Do
    Inc Word_list_limit% ! move to next slot
    Read Hold_word_list$(Word_list_limit%) ! read the word
    Exit If Hold_word_list$(Word_list_limit%)="//" ! special end marker
    If Hold_word_list$(Word_list_limit%)<=Hold_word_list$(Word_list_limit%-1)
      Print "words out of sequence ->";
      Print Hold_word_list$(Word_list_limit%-1);", ";
      Print Hold_word_list$(Word_list_limit%)
      Stop ! sequence error must be fixed
    Endif
  Loop
Return ! now the words follow
Data ABS,ADD,ALERT,AND,ARRAYFILL,ARRPTR,AS,ASC,AT,ATN
Data BASE,BGET,BIN$,BITBLT,BLOAD,BMOVE,BOX,BPUT,BREAK,BSAVE
Data C:,CALL,CHAIN,CHDIR,CHDRIVE,CHR$,CIRCLE,CLEAR,CLEARW,CLOSE,CLOSEW
Data CLR,CLS,COLOR,COS,CRSCOL,CRSLIN,CVD,CVF,CVI,CVL,CVS
Data DATE$,DEC,DEFFILL,DEFFN,DEFLINE,DEFLIST,DEFMARK,DEFMOUSE,DEFNUM,DEFTEXT
Data DFREE,DIM,DIM?,DIR,DIR$,DIV,DO,DOWNTO,DPEEK,DPOKE,DRAW
Data EDIT,ELLIPSE,ELSE,END,ENDIF,EOF,EQV,ERASE,ERR,ERROR,EVEN,EXEC,EXIST
Data EXIT,EXP
Data FALSE,FATAL,FIELD,FILES,FILESELECT,FILL,FIX,FOR,FORM,FRAC,FRE,FULLW
Data GET,GOSUB,GOTO,GRAPHMODE
Data HARDCOPY,HEX$,HIDEM,HIMEM
Data IF,IMP,INC,INFOW,INKEY$,INP,INP?,INPUT,INPUT$,INSTR,INT
Data KILL
Data LEFT$,LEN,LET,LINE,LIST,LLIST,LOAD,LOC,LOCAL,LOF,LOG,LOG10,LOOP,LPEEK
Data LPOKE,LPOS,LPRINT,LSET
Data MAX,MENU,MID$,MIN,MKD$,MKDIR,MKF$,MKI$,MKL$,MKS$,MOD,MONITOR,MOUSE,MOUSEK
Data MOUSEX,MOUSEY,MUL
Data NAME,NEW,NEXT,NOT
Data OCT$,ODD,ON,OPEN,OPENW,OPTION,OR,OUT,OUT?
Data PAUSE,PBOX,PCIRCLE,PEEK,PELLIPSE,PLOT,POINT,POKE,POLYFILL,POLYLINE
Data POLYMARK,POS,PRBOX,PRINT,PROCEDURE,PSAVE,PUT
Data QUIT
Data RANDOM,RBOX,READ,RELSEEK,REPEAT,RESERVE,RESTORE,RESUME,RETURN,RIGHT$
Data RMDIR,RND
Data SAVE,SDPOKE,SEEK,SETCOLOR,SETTIME,SGET,SGN,SHOWM,SIN,SLPOKE,SOUND
Data SPACE$,SPC,SPOKE,SPRITE,SPUT,SQR,STOP,STR$,STRING$,SUB,SWAP,SYSTEM
Data TAB,TAN,TEXT,TIME$,TIMER,TITLEW,TO,TROFF,TRON,TRUE,TRUNC,TYPE
Data UNTIL,UPPER$,USING
Data VAL,VAL?,VARPTR,VOID,VSYNC
Data WAVE,WEND,WHILE,WRITE
Data XOR
Data //,end of basic keyword list
Procedure Get_filenames
  Rem
  Rem this routine gets all the filenames needed for this program
  Rem
  Print "Select Ascii-saved Basic program"
  A$="A:\*.LST"
  B$=""
  Ok!=False
  Repeat
    Fileselect A$,B$,Lst$
    If Lst$=""
      End
    Endif
    If Exist(Lst$)
      Ok!=True
    Else
      Print "(doesn't exist, try again)"
    Endif
    @Take_filename_apart(Lst$,*A$,*B$)
  Until Ok!
  Cls ! clear screen again
  Ok!=False
  Print Lst$
  X%=Instr(B$,".")
  If X%=0
    B$=B$+".lnm"
  Else
    B$=Left$(B$,X%)+"lnm"
  Endif
  A$=A$+"*.LNM"
  Print "Select numbered-program file"
  Fileselect A$,B$,Lnm$
  If Lnm$=""
    End
  Endif
  Cls
  Print Lst$;"   ";
  Print Lnm$
  @Take_filename_apart(Lnm$,*A$,*B$)
  Y%=Instr(B$,".")
  If Y%=0
    B$=B$+".xrf"
  Else
    B$=Left$(B$,Y%)+"xrf"
  Endif
  A$=A$+"*.xrf"
  Print "Select xref file"
  Fileselect A$,B$,Xrf$
  If Xrf$=""
    End
  Endif
  Cls
  Print Lst$;"   ";
  Print Lnm$;"   ";
  Print Xrf$
  Print "Select DRIVE for temp files (filename doesn't matter)"
  @Take_filename_apart(Xrf$,*A$,*B$)
  Fileselect A$," ",Junk$
  @Take_filename_apart(Junk$,*Tdrive$,*A$)
  Rem out of that, only drive$ matters
  Print "Selecting temp files ";
  Repeat
    Tempfile1$=Tdrive$+"F1"+Str$(Random(10000))
  Until Not Exist(Tempfile1$)
  Repeat
    Tempfile2$=Tdrive$+"F2"+Str$(Random(10000))
  Until Not Exist(Tempfile2$)
  Repeat
    Tempfile3$=Tdrive$+"F3"+Str$(Random(10000))
  Until Not Exist(Tempfile3$)
  Repeat
    Tempfile4$=Tdrive$+"F4"+Str$(Random(10000))
  Until Not Exist(Tempfile4$)
  Print Tempfile1$;" ";Tempfile2$;" ";Tempfile3$;" ";Tempfile4$
Return
Procedure Take_filename_apart(Pathname$,P.path%,P.name%)
  Rem
  Rem this routine examines the filename (with path) in pathname$
  Rem the path (up to final \) will be put in p.path
  Rem the filename only will be put in p.name
  Rem
  Local X%,Y%
  X%=Instr(Pathname$,":")
  Repeat
    Y%=X%
    X%=Max(Instr(Y%+1,Pathname$,"\"),Instr(Y%+1,Pathname$,"/"))
  Until X%=0
  If Y%=0
    *P.path%=Dir$
    *P.name%=Pathname$
  Else
    *P.path%=Left$(Pathname$,Y%)
    *P.name%=Mid$(Pathname$,Y%+1)
  Endif
Return
Procedure Deletef
  Rem
  Rem this is a utility routine, it deletes all the temp files this
  Rem program has left laying around.
  Rem
  Rem notes: (1) it assumes files are in the root of drive P:, my ramdisk
  Rem        (2) it is dangerous - can easily delete too much
  Rem
  While Exist("p:f*")
    Kill "p:f*"
  Wend
Return
Procedure Sort_references
  Rem
  Rem this routine does some overhead for a merge sort of the disk file
  Rem containing the list of references
  Rem
  Print "sorting - pass ";
  Lnox%=Crscol
  Lnoy%=Crslin
  Pass%=0
  Qqqinputbuf$="" ! to free memory
  Void Fre(0)
  Open "O",#1,Tempfile2$ ! create null file
  Close #1 ! done with it
  Repeat
    @Sort_one_pass
  Until Not Side2!
  Kill Tempfile2$
  Kill Tempfile3$
  Kill Tempfile4$
Return
Procedure Sort_one_pass
  Rem
  Rem this routine does one pass of a merge sort
  Rem at present it's strictly a two-by merge.
  Rem
  Inc Pass% ! print pass# so user doesn't get too impatient
  Print At(Lnox%,Lnoy%);Pass%
  Rcnt%=0 ! initialize record and segment counters
  Seg%=1
  Open "I",#1,Tempfile1$ ! open files
  Open "I",#2,Tempfile2$
  Open "O",#3,Tempfile3$
  Open "O",#4,Tempfile4$
  Side2!=False ! haven't used the second output file yet
  Ofile!=False ! switch for which output file to use
  F1oc!=False ! input record buffers not occupied
  F2oc!=False
  Old$="" ! no previous record
  Oldr=0
  Repeat
    If Not F1oc! ! should fill buffer 1, preferably from input 1
      On Error Gosub Errone
      If Not Eof(#1)
        Input #1,Ref1,Var1$ ! read the record
        Inc Rcnt% ! count it
        F1oc!=True ! buffer now occupied
      Else ! have to read from input 2 instead
        If Not Eof(#2) ! if we can
          Input #2,Ref1,Var1$ ! read the record
          Inc Rcnt% ! count it
          F1oc!=True ! buffer occupied
        Endif
      Endif
    Endif
    Eofone:
    If Not F2oc! ! should fill buffer 2 - see above
      On Error Gosub Errtwo
      If Not Eof(#2)
        Input #2,Ref2,Var2$
        Inc Rcnt%
        F2oc!=True
      Else
        If Not Eof(#1)
          Input #1,Ref2,Var2$
          Inc Rcnt%
          F2oc!=True
        Endif
      Endif
    Endif
    Eoftwo:
    On Error ! normal error handling
    If ((Var1$<Old$ Or (Var1$=Old$ And Ref1<Oldr)) Or Not F1oc!) And ((Var2$<Old$ Or (Var2$=Old$ And Ref2<Oldr)) Or Not F2oc!)
      Rem have completed a "run", must switch output files
      Ofile!=Not Ofile! ! switch the indicator
      Inc Seg% ! count the next run
      Oldr=0 ! no previous record in the run
      Old$=""
    Endif
    If F1oc! And (Var1$>Old$ Or (Var1$=Old$ And Ref1>=Oldr)) And ((Var1$<Var2$ Or (Var1$=Var2$ And Ref1<=Ref2)) Or (Not F2oc!) Or (Var2$<Old$ Or (Var2$=Old$ And Ref2<Oldr)))
      Rem should write record in buffer 1
      @Sort_out(Ref1,Var1$) ! call routine to write it
      F1oc!=False ! now the buffer's empty
    Else
      If F2oc! And (Var2$>Old$ Or (Var2$=Old$ And Ref2>=Oldr)) And ((Var2$<Var1$ Or (Var2$=Var1$ And Ref2<=Ref1)) Or (Not F1oc!) Or (Var1$<Old$ Or (Var1$=Old$ And Ref1<Oldr)))
        Rem should write record in buffer 2
        @Sort_out(Ref2,Var2$) ! call routine to write it
        F2oc!=False ! now the buffer's empty
        Rem if both buffers are occupied or both files are at eof, should always
        Rem be writing one of the two buffers out.
      Endif
    Endif
  Until Eof(#1) And Eof(#2) And Not (F1oc! Or F2oc!)
  Close #1 ! close all the files
  Close #2
  Close #3
  Close #4
  Swap Tempfile1$,Tempfile3$ ! ready for next pass
  Swap Tempfile2$,Tempfile4$ ! files 1&2 always input, 3&4 always output
  Print "last pass had ";Rcnt%;" records in ";Seg%;" segments"," "
Return
Procedure Sort_out(X,Y$)
  Rem
  Rem output a record to the sort output file
  Rem
  Old$=Y$ ! save "previous-record" stuff for future use
  Oldr=X
  If Ofile! ! pick which file to write to
    Side2!=True ! at least two runs, we'll need another pass
    Print #4;X;",";Y$ ! write to file 4
  Else
    Print #3;X;",";Y$ ! write to file 3
  Endif
Return
Rem
Rem error (eof) routines for the above sort follow.
Procedure Errone
  Resume Eofone
Return
Procedure Errtwo
  Resume Eoftwo
Return
Rem
Procedure Errthree
  Rem
  Rem this special eof routine provides a dummy value for the
  Rem combine logic in the next procedure
  Rem
  Var2$="//"
  Resume Next
Return
Procedure Combine_references
  Rem
  Rem this routine reads the sorted references file
  Rem and produces one record for each different variable.
  Rem
  Print "combining..."
  Open "I",#1,Tempfile1$ ! open files
  Open "O",#2,Tempfile2$
  Input #1,Ref1$,Var1$ ! read the first record
  Var2$="" ! clear to start the loop
  While Var2$<>"//" ! watching for special eof marker
    On Error Gosub Errthree ! provide for it
    Input #1,Ref2$,Var2$ ! get the next record
    On Error ! back to standard error handling
    If Var2$=Var1$ ! if same variable
      Ref1$=Ref1$+" "+Ref2$ ! combine the reference lists
    Else ! not the same variable
      Print #2;Ref1$;",";Var1$ ! write the "old" variable & list
      Ref1$=Ref2$ ! start on the new one
      Var1$=Var2$
    Endif
  Wend ! and go on
  Close #1 ! close files
  Close #2
  Swap Tempfile1$,Tempfile2$ ! still want #1 to be input
  Kill Tempfile2$ ! get rid of unneeded file
Return
Procedure Format_report
  Rem
  Rem this routine reads the combined file to produce the actual
  Rem cross-reference report
  Rem
  Print "formatting report"
  Open "I",#1,Tempfile1$ ! open files
  Open "O",#2,Xrf$
  On Error Gosub Errfour ! protect eof
  Namform$="\"+Space$(18)+"\ " ! formats for print using
  Numform$="#### "
  While Not Eof(#1) ! thru the file
    Input #1,Ref1$,Var1$ ! read a record
    St%=1 ! starting position in ref1$
    Cl%=0 ! starting position on line
    While St%<Len(Ref1$) ! until done with references
      If Cl%>56 ! line is full
        Print #2 ! end the line
        Cl%=0 ! ready for a new line
      Endif
      If Cl%=0 ! if at beginning of line
        Print #2,Using Namform$,Var1$; ! print the variable name
        Cl%=Cl%+Len(Namform$) ! move ahead in line
        Var1$="" ! but only print name once per variable
      Endif
      En%=Instr(St%,Ref1$," ") ! find the end of the next line#
      If En%=0 ! if there isn't a space,
        En%=Len(Ref1$) ! use the rest of the references
      Endif
      Ll%=En%-St%+1 ! how many characters?
      Print #2,Using Numform$,Val(Mid$(Ref1$,St%,Ll%)); ! print the number
      Cl%=Cl%+Len(Numform$) ! move ahead in line
      St%=En%+1 ! move to next reference
    Wend
    Print #2 ! end of a variable - end the line
  Wend
  Eoffour: ! also come here indirectly on eof
  Close #1 ! close files
  Close #2
  Kill Tempfile1$ ! get rid of temporaries
Return
Procedure Errfour
  Rem
  Rem special eof routine for the final reporting phase
  Rem
  Resume Eoffour
Return